with R Markdown

Diamond 4C

I. Cut (車工)

鑽石切工締造璀璨光芒

高折射率造就了鑽石的璀璨光芒，使其聞名於世。許多人會把鑽石切工等同於鑽石的形狀（圓形、心形、橢圓形、馬眼形、梨形）。實際上鑽石切工等級取決於其刻面與光線的相互作用結果。

II. Clarity (淨度)

鑽石淨度是指其無內含物和表面特徵的程度

天然鑽石是碳元素在高溫高壓的環境下形成的。而這一過程，也導致了每顆鑽石有內部的特徵，稱為“內含物”，在鑽石表面的特徵則稱為“表面特徵”。

對鑽石淨度的評定，包括了對上述特徵的數量、大小、可見度、類型、位置和對鑽石整體外觀的影響程度的鑑定。儘管世上沒有絕對完美無瑕的天然鑽石，但淨度越高的鑽石，價值越高。

GIA 的鑽石淨度標準分為 6 個類別，11 個等級。

III. Carat (克拉重量)

鑽石克拉重量用於衡量鑽石的外觀尺寸

克拉是用於衡量鑽石重量的單位。1 克拉等於 200 毫克。

在對鑽石重量進行測量時，1 克拉又等同於 100 “分”，從而使克拉重量精確到小數點後兩位。珠寶商可以直接用“分” 來描述一顆重量小於1 克拉的鑽石。比如，0.25 克拉的鑽石又被稱作“二十五分”。但對於1 克拉以上的鑽石， 只能用精確到百分位的“克拉”來描述。比如，1.08 克拉的鑽石只能用“一點零八克拉” 來說明其重量。

在所有其他條件都一樣的情況下，鑽石越大，其稀有程度就越高，也越受青睞。因此，鑽石的價格會隨著鑽石克拉重量的增加而上升。

IV. Color (顏色)

鑽石顏色實際上是指其無色的程度

對大多數寶石級鑽石來說，其顏色鑑定標準取決於它的無色程度。一顆不含化學雜質且結構完美的鑽石就像純淨的水滴一樣，是沒有色彩的，且具有更高的價值。GIA 創立了D 到Z 鑽石顏色分級系統，通過在精確受控的照明、觀測條件下，將鑽石與比色石比對，來鑑定其無色程度。

Codebook

names(diamonds)

 [1] "carat"     "cut"       "color"     "clarity"   "depth"     "table"    
 [7] "price"     "x"         "y"         "z"         "price_grp"

vars= names(diamonds)
codebook= summary(diamonds) %>% split(col(.))
names(codebook)= vars
descript= 
  c('克拉','裁切等級','鑽石顏色','鑽石淨度', '總深度百分比','鑽石的最大刻面', 
    '價錢(美元)','長度(mm)', '寬度(mm)','深度(mm)')
cb = rbind.data.frame(descript, codebook) %>% t
kable(cb) %>% kable_classic(html_font = 'Times New Roman')

carat	克拉	Min. :0.2000	1st Qu.:0.4000	Median :0.7000	Mean :0.7979	3rd Qu.:1.0400	Max. :5.0100
cut	裁切等級	Fair : 1610	Good : 4906	Very Good:12082	Premium :13791	Ideal :21551
color	鑽石顏色	D: 6775	E: 9797	F: 9542	G:11292	H: 8304	I: 5422	J: 2808
clarity	鑽石淨度	SI1 :13065	VS2 :12258	SI2 : 9194	VS1 : 8171	VVS2 : 5066	VVS1 : 3655	(Other): 2531
depth	總深度百分比	Min. :43.00	1st Qu.:61.00	Median :61.80	Mean :61.75	3rd Qu.:62.50	Max. :79.00
table	鑽石的最大刻面	Min. :43.00	1st Qu.:56.00	Median :57.00	Mean :57.46	3rd Qu.:59.00	Max. :95.00
price	價錢(美元)	Min. : 326	1st Qu.: 950	Median : 2401	Mean : 3933	3rd Qu.: 5324	Max. :18823
x	長度(mm)	Min. : 0.000	1st Qu.: 4.710	Median : 5.700	Mean : 5.731	3rd Qu.: 6.540	Max. :10.740
y	寬度(mm)	Min. : 0.000	1st Qu.: 4.720	Median : 5.710	Mean : 5.735	3rd Qu.: 6.540	Max. :58.900
z	深度(mm)	Min. : 0.000	1st Qu.: 2.910	Median : 3.530	Mean : 3.539	3rd Qu.: 4.040	Max. :31.800
price_grp	克拉	min-Q1 :13490	Q1-median:13495	median-Q3:13470	Q3-Max :13485

Distribution

Cut

diamonds %>%
  ggplot(aes(x=cut,y=price, fill=cut)) +
  geom_violin()->p; plotly::ggplotly(p,width = 9)

Clarity

diamonds %>%
  ggplot(aes(x=clarity,y=price, fill=clarity)) +
  geom_violin()->p; plotly::ggplotly(p,width = 9)

Carat

diamonds$carat_grp= cut(diamonds$carat, fivenum(diamonds$carat),include.lowest = T)

Found more than one class "tbl_df" in cache; using the first, from namespace 'tibble'
Also defined by ‘memisc’

diamonds %>%
  ggplot(aes(x=carat_grp,y=price, fill=carat_grp)) +
  geom_violin()->p; plotly::ggplotly(p,width = 9)

Color

diamonds %>%
  ggplot(aes(x=color,y=price, fill=color)) +
  geom_violin()->p; plotly::ggplotly(p,width = 9)

Correlation matrix

M= 
  diamonds %>% 
  dplyr::select(price, carat,depth,table,x,y,z) %>% 
  cor
  
M[lower.tri(M)] <- NA
M %>% pheatmap(display_numbers = T, number_color = 'white', cluster_rows=F, cluster_cols=F, na_col="white", color = rev(brewer.pal(10, 'RdBu')))

Scatter plot

diamonds %>%
  ggplot(aes(carat, price, col= color))+
  geom_point() + facet_grid(cut~clarity)

Summary table

diamonds$price_grp= 
  cut(diamonds$price, fivenum(diamonds$price), include.lowest = T, labels = c('<Q1','Q1-median','median-Q3', '>Q3'))

Found more than one class "tbl_df" in cache; using the first, from namespace 'tibble'
Also defined by ‘memisc’

library(moonBook)
mytable(price_grp~.,diamonds) %>% mytable2df() %>% kable() %>% kable_classic()

name	<Q1	Q1-median	median-Q3	>Q3	p
	(N=13490)	(N=13495)	(N=13470)	(N=13485)
carat	0.3 ± 0.0	0.5 ± 0.1	0.9 ± 0.2	1.4 ± 0.4	0.000
cut					0.000
- Fair	88 ( 0.7%)	462 ( 3.4%)	667 ( 5.0%)	393 ( 2.9%)
- Good	1057 ( 7.8%)	1087 ( 8.1%)	1634 (12.1%)	1128 ( 8.4%)
- Very Good	3129 (23.2%)	2533 (18.8%)	3369 (25.0%)	3051 (22.6%)
- Premium	2907 (21.5%)	3069 (22.7%)	3504 (26.0%)	4311 (32.0%)
- Ideal	6309 (46.8%)	6344 (47.0%)	4296 (31.9%)	4602 (34.1%)
color					0.000
- D	1878 (13.9%)	2047 (15.2%)	1698 (12.6%)	1152 ( 8.5%)
- E	2790 (20.7%)	2984 (22.1%)	2471 (18.3%)	1552 (11.5%)
- F	2268 (16.8%)	2642 (19.6%)	2520 (18.7%)	2112 (15.7%)
- G	2917 (21.6%)	2962 (21.9%)	2227 (16.5%)	3186 (23.6%)
- H	2023 (15.0%)	1448 (10.7%)	2308 (17.1%)	2525 (18.7%)
- I	1184 ( 8.8%)	888 ( 6.6%)	1459 (10.8%)	1891 (14.0%)
- J	430 ( 3.2%)	524 ( 3.9%)	787 ( 5.8%)	1067 ( 7.9%)
clarity					0.000
- I1	55 ( 0.4%)	189 ( 1.4%)	319 ( 2.4%)	178 ( 1.3%)
- SI2	1024 ( 7.6%)	1530 (11.3%)	4104 (30.5%)	2536 (18.8%)
- SI1	2933 (21.7%)	2859 (21.2%)	4119 (30.6%)	3154 (23.4%)
- VS2	3389 (25.1%)	3109 (23.0%)	2200 (16.3%)	3560 (26.4%)
- VS1	2297 (17.0%)	2189 (16.2%)	1433 (10.6%)	2252 (16.7%)
- VVS2	1784 (13.2%)	1530 (11.3%)	666 ( 4.9%)	1086 ( 8.1%)
- VVS1	1392 (10.3%)	1356 (10.0%)	458 ( 3.4%)	449 ( 3.3%)
- IF	616 ( 4.6%)	733 ( 5.4%)	171 ( 1.3%)	270 ( 2.0%)
depth	61.8 ± 1.2	61.7 ± 1.4	61.8 ± 1.7	61.7 ± 1.5	0.000
table	57.0 ± 2.1	57.2 ± 2.3	57.9 ± 2.3	57.8 ± 2.1	0.000
price	687.9 ± 149.4	1563.3 ± 443.6	3790.7 ± 852.7	9692.1 ± 3657.3	0.000
x	4.4 ± 0.2	5.2 ± 0.4	6.2 ± 0.4	7.2 ± 0.6	0.000
z	2.7 ± 0.1	3.2 ± 0.4	3.8 ± 0.3	4.4 ± 0.4	0.000
carat_grp					0.000
- [0.2,0.4]	12076 (89.5%)	2315 (17.2%)	0 ( 0.0%)	0 ( 0.0%)
- (0.4,0.7]	1413 (10.5%)	9776 (72.4%)	1573 (11.7%)	9 ( 0.1%)
- (0.7,1.04]	1 ( 0.0%)	1386 (10.3%)	9434 (70.0%)	2578 (19.1%)
- (1.04,5.01]	0 ( 0.0%)	18 ( 0.1%)	2463 (18.3%)	10898 (80.8%)

Building the Linear Model

diamonds1 = diamonds

diamonds1$cut <- factor(diamonds1$cut, ordered=F)

diamonds1$color <- factor(diamonds1$color, ordered=F)

diamonds1$clarity <- factor(diamonds1$clarity, ordered=F)

m1 <- lm(I(log(price)) ~ I(carat^(1/3)), data = diamonds1)
m2 <- update(m1, ~ . + carat)
m3 <- update(m2, ~ . + cut)
m4 <- update(m3, ~ . + color)
m5 <- update(m4, ~ . + clarity)

mt = memisc::mtable(m1, m2, m3, m4, m5, sdigits=4, getSummary=NULL,  
               summary.stats=c("R-squared", "adj. R-squared", "sigma", "F","p",
                               "Log-likelihood", "Deviance", "AIC", "BIC", "N"))

	m1			m2			m3			m4			m5
(Intercept)	2	.	821***	1	.	039***	0	.	685***	0	.	891***	−0	.	172***
	(0	.	006)	(0	.	019)	(0	.	020)	(0	.	018)	(0	.	011)
I(carat^(1/3))	5	.	558***	8	.	568***	8	.	703***	8	.	438***	9	.	144***
	(0	.	007)	(0	.	032)	(0	.	031)	(0	.	028)	(0	.	016)
carat				−1	.	137***	−1	.	163***	−0	.	992***	−1	.	093***
				(0	.	012)	(0	.	011)	(0	.	010)	(0	.	006)
cut: Good/Fair							0	.	159***	0	.	158***	0	.	077***
							(0	.	007)	(0	.	006)	(0	.	004)
cut: Very Good/Fair							0	.	236***	0	.	235***	0	.	112***
							(0	.	007)	(0	.	006)	(0	.	003)
cut: Premium/Fair							0	.	236***	0	.	235***	0	.	135***
							(0	.	007)	(0	.	006)	(0	.	003)
cut: Ideal/Fair							0	.	316***	0	.	316***	0	.	160***
							(0	.	007)	(0	.	006)	(0	.	003)
color: E/D										−0	.	026***	−0	.	055***
										(0	.	004)	(0	.	002)
color: F/D										−0	.	036***	−0	.	096***
										(0	.	004)	(0	.	002)
color: G/D										−0	.	063***	−0	.	163***
										(0	.	003)	(0	.	002)
color: H/D										−0	.	196***	−0	.	256***
										(0	.	004)	(0	.	002)
color: I/D										−0	.	295***	−0	.	375***
										(0	.	004)	(0	.	002)
color: J/D										−0	.	426***	−0	.	511***
										(0	.	005)	(0	.	003)
clarity: SI2													0	.	420***
													(0	.	005)
clarity: SI1													0	.	585***
													(0	.	005)
clarity: VS2													0	.	733***
													(0	.	005)
clarity: VS1													0	.	803***
													(0	.	005)
clarity: VVS2													0	.	934***
													(0	.	005)
clarity: VVS1													1	.	006***
													(0	.	005)
clarity: IF													1	.	101***
													(0	.	006)
R-squared	0	.	9236	0	.	9349	0	.	9391	0	.	9514	0	.	9839
adj. R-squared	0	.	9236	0	.	9349	0	.	9391	0	.	9514	0	.	9839
sigma	0	.	2805	0	.	2588	0	.	2504	0	.	2237	0	.	1286
F	652012	.	0628	387489	.	3661	138654	.	5235	87959	.	4667	173791	.	0840
p	0	.	0000	0	.	0000	0	.	0000	0	.	0000	0	.	0000
Log-likelihood	−7962	.	4993	−3631	.	3185	−1837	.	4158	4235	.	2405	34091	.	2720
Deviance	4242	.	8307	3613	.	3602	3380	.	8373	2699	.	2124	892	.	2143
AIC	15930	.	9985	7270	.	6370	3690	.	8316	−8442	.	4809	−68140	.	5440
BIC	15957	.	6854	7306	.	2195	3761	.	9966	−8317	.	9421	−67953	.	7358
N	53940			53940			53940			53940			53940
Significance: *** = p < 0.001; ** = p < 0.01; * = p < 0.05

Rerence

1. https://www.bluenile.com/tw/education/diamonds/cut
2. https://4cs.gia.edu/en-us/diamond-color/
3. https://www.directdiam.com/pages/diamonds-4cs
4. https://gallery.azure.ai/Experiment/Diamond-dataset
5. panelset: https://pkg.garrickadenbuie.com/xaringanExtra/panelset/rmarkdown.html?panelset1=tab-a&panelset=tabset%252Fpanelset
6. https://rstudio-pubs-static.s3.amazonaws.com/211979_60432c2480574f419f646c9834768a77.html